home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / lib / tclX6.4c / dist / experimental / debugger / ndebug.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-03-29  |  8.1 KB  |  306 lines
  1.  
  2. /*
  3.  
  4. New Tcl debugger
  5.  
  6.     tcl proc gets executed by trace routine.
  7.  
  8.     trace is turned off while tcl proc is being executed.
  9.  
  10.     result of tcl proc, or via some control mechanism,
  11.     options will include "step in" (set trace depth higher),
  12.     "step", "stop" and "continue".  also it would be nice
  13.     to be able to change an arg, print vars, stuff like that.
  14.  
  15. can add global to disable tracing so prompt won't be traced.
  16.  
  17. see if there's a proc line number in the interpreter structure
  18.  
  19.  
  20. add a maxlevel where trace returns quickly if a maxlevel is exceeded.
  21. This allows single stepping without step-in, step-in, etc, by playing
  22. with the value.
  23.  
  24. look at return from the eval in the trace procedure as a means of
  25. determining whether to step or whatever, or maybe control it through
  26. a command or variable.
  27.  
  28. */
  29.  
  30.  
  31. /*
  32.  * ndebug.c --
  33.  *
  34.  * Tcl debugger.
  35.  *---------------------------------------------------------------------------
  36.  * Copyright 1992 Karl Lehenbauer and Mark Diekhans.
  37.  *
  38.  * Permission to use, copy, modify, and distribute this software and its
  39.  * documentation for any purpose and without fee is hereby granted, provided
  40.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  41.  * Mark Diekhans make no representations about the suitability of this
  42.  * software for any purpose.  It is provided "as is" without express or
  43.  * implied warranty.
  44.  */
  45.  
  46. #include "tclExtdInt.h"
  47.  
  48. /*
  49.  * Clientdata structure for trace commands.
  50.  */
  51. #define ARG_TRUNCATE_SIZE 40
  52. #define CMD_TRUNCATE_SIZE 60
  53.  
  54. struct traceInfo_t {
  55.     Tcl_Interp *interp;
  56.     Tcl_Trace   traceHolder;
  57.     int         depth;
  58.     int         depthFloor;
  59.     };
  60. typedef struct traceInfo_t *traceInfo_pt;
  61.  
  62. static void
  63. TraceRoutine _ANSI_ARGS_((ClientData    clientData,
  64.                           Tcl_Interp   *interp,
  65.                           int           level,
  66.                           char         *command,
  67.                           int           (*cmdProc)(),
  68.                           ClientData    cmdClientData,
  69.                           int           argc,
  70.                           char         *argv[]));
  71.  
  72. static void
  73. CleanUpDebug _ANSI_ARGS_((ClientData clientData));
  74.  
  75. /*
  76.  *----------------------------------------------------------------------
  77.  *
  78.  * TraceRoutine --
  79.  *  Routine called by Tcl_Eval to trace a command.
  80.  *
  81.  *----------------------------------------------------------------------
  82.  */
  83. /* static void */
  84. void
  85. TraceRoutine (clientData, interp, level, command, cmdProc, cmdClientData, 
  86.               argc, argv)
  87.     ClientData    clientData;
  88.     Tcl_Interp   *interp;
  89.     int           level;
  90.     char         *command;
  91.     int           (*cmdProc)();
  92.     ClientData    cmdClientData;
  93.     int           argc;
  94.     char         *argv[];
  95. {
  96.     traceInfo_pt traceInfoPtr = (traceInfo_pt) clientData;
  97.     int          idx, cmdLen, printLen;
  98.     int          result;
  99.     char         depthText[12];
  100.     char        *stepCommand;
  101.     char        *stepArgs[4];
  102.  
  103.     static int   inTraceRoutine = 0;
  104.  
  105.     /* Don't try to trace the trace routine.  (We can't delete and recreate
  106.      * the trace, because we're being called from a for-loop that won't
  107.      * see such changes, i.e. trace routines cannot safely delete traces.
  108.      *
  109.      * Also we do our own should-we-trace-at-this-depth processing rather
  110.      * than letting regular tcl handle it, so that we can change the depth
  111.      * we want without having to delete and recreate the trace.
  112.      */
  113.     if (inTraceRoutine || (level > traceInfoPtr->depth))
  114.     return;
  115.     inTraceRoutine = 1;
  116.  
  117.     if (traceInfoPtr->depthFloor == -1) {
  118.     traceInfoPtr->depthFloor = level;
  119.     traceInfoPtr->depth = level + 1;
  120.     }
  121.  
  122.     /* build up arguments to the trace routine */
  123.     sprintf (depthText, "%d", level);
  124.  
  125.     stepArgs[0] = "trace_step";
  126.     stepArgs[1] = depthText;
  127.     stepArgs[2] = command;
  128.     stepArgs[3] = Tcl_Merge (argc, argv);
  129.  
  130.     stepCommand = Tcl_Merge (4, stepArgs);
  131.  
  132.     ckfree (stepArgs[3]);
  133.  
  134.     result = Tcl_Eval (interp, stepCommand, 0, NULL);
  135.     if ((result != TCL_OK) && (result != TCL_RETURN)) {
  136.     printf("error in trace_step: %s\n", interp->result);
  137.     }
  138.  
  139.     ckfree (stepCommand);
  140.  
  141.     inTraceRoutine = 0;
  142.     return;
  143. }
  144.  
  145. /*
  146.  *----------------------------------------------------------------------
  147.  *
  148.  * Tcl_TraceConCmd --
  149.  *     Implements the TCL trace control command:
  150.  *     tracecon depth [level]
  151.  *     tracecon depthfloor [level]
  152.  *
  153.  * Results:
  154.  *  Standard TCL results.
  155.  *
  156.  *----------------------------------------------------------------------
  157.  */
  158. static int
  159. Tcl_TraceConCmd (clientData, interp, argc, argv)
  160.     ClientData    clientData;
  161.     Tcl_Interp   *interp;
  162.     int           argc;
  163.     char        **argv;
  164. {
  165.     traceInfo_pt infoPtr = (traceInfo_pt) clientData;
  166.     int          idx;
  167.  
  168.     if (argc < 2)
  169.         goto argumentError;
  170.  
  171.     /*
  172.      * Handle `depth' sub-command.
  173.      */
  174.     if (STREQU (argv[1], "depth")) {
  175.     if (argc == 2) {
  176.             sprintf(interp->result, "%d", infoPtr->depth);
  177.             return TCL_OK;
  178.     }
  179.     if (argc == 3) {
  180.             return (Tcl_GetInt (interp, argv[2], &(infoPtr->depth)));
  181.     }
  182.     goto argumentError;
  183.     }
  184.  
  185.     if (STREQU (argv[1], "depthfloor")) {
  186.     if (argc == 2) {
  187.             sprintf(interp->result, "%d", infoPtr->depthFloor);
  188.             return TCL_OK;
  189.     }
  190.     if (argc == 3) {
  191.             return (Tcl_GetInt (interp, argv[2], &(infoPtr->depthFloor)));
  192.     }
  193.     goto argumentError;
  194.     }
  195.  
  196. argumentError:
  197.     Tcl_AppendResult (interp, "wrong # args: ", argv [0], 
  198.                       " depth [level]", (char *) NULL);
  199.     return TCL_ERROR;
  200.  
  201. }
  202.  
  203. /*
  204.  *----------------------------------------------------------------------
  205.  *
  206.  * Tcl_TraceProcCmd --
  207.  *     Implements the TCL traceproc command:
  208.  *     traceproc procname [arg...]
  209.  *
  210.  * Results:
  211.  *  Standard TCL results.
  212.  *
  213.  *----------------------------------------------------------------------
  214.  */
  215. static int
  216. Tcl_TraceProcCmd (clientData, interp, argc, argv)
  217.     ClientData    clientData;
  218.     Tcl_Interp   *interp;
  219.     int           argc;
  220.     char        **argv;
  221. {
  222.     register Interp *iPtr = (Interp *) interp;
  223.     traceInfo_pt infoPtr = (traceInfo_pt) clientData;
  224.     int          idx;
  225.     char        *commandToBeTraced;
  226.     int          result;
  227.  
  228.     if (argc < 2) {
  229.         Tcl_AppendResult (interp, "wrong # args: ", argv [0], 
  230.                           " procname [arg...]", (char *) NULL);
  231.         return TCL_ERROR;
  232.     }
  233.  
  234.     /*
  235.      * If a trace is in progress, delete it now.
  236.      */
  237.     if (infoPtr->traceHolder != NULL) {
  238.         Tcl_DeleteTrace(interp, infoPtr->traceHolder);
  239.         infoPtr->traceHolder = NULL;
  240.     }
  241.  
  242.     infoPtr->depth = MAXINT;
  243.     infoPtr->depthFloor = -1;
  244.       
  245.     infoPtr->traceHolder = 
  246.         Tcl_CreateTrace (interp, MAXINT, TraceRoutine, 
  247.                          (ClientData)infoPtr);
  248.  
  249.     commandToBeTraced = Tcl_Merge (argc - 1, &argv[1]);
  250.     result = Tcl_Eval (interp, commandToBeTraced, 0, NULL);
  251.     ckfree (commandToBeTraced);
  252.  
  253.     Tcl_DeleteTrace (infoPtr->interp, infoPtr->traceHolder);
  254.  
  255.     return TCL_OK;
  256. }
  257.  
  258.  
  259. /*
  260.  *----------------------------------------------------------------------
  261.  *
  262.  *  CleanUpDebug --
  263.  *
  264.  *  Release the client data area when the trace command is deleted.
  265.  *
  266.  *----------------------------------------------------------------------
  267.  */
  268. static void
  269. CleanUpDebug (clientData)
  270.     ClientData clientData;
  271. {
  272.     traceInfo_pt infoPtr = (traceInfo_pt) clientData;
  273.  
  274.     if (infoPtr->traceHolder != NULL)
  275.         Tcl_DeleteTrace (infoPtr->interp, infoPtr->traceHolder);
  276.     ckfree ((char *) infoPtr);
  277. }
  278.  
  279. /*
  280.  *----------------------------------------------------------------------
  281.  *
  282.  *  Tcl_InitDebug --
  283.  *
  284.  *  Initialize the TCL debugging commands.
  285.  *
  286.  *----------------------------------------------------------------------
  287.  */
  288. void
  289. Tcl_InitnDebug (interp)
  290.     Tcl_Interp *interp;
  291. {
  292.     traceInfo_pt infoPtr;
  293.  
  294.     infoPtr = (traceInfo_pt)ckalloc (sizeof (struct traceInfo_t));
  295.  
  296.     infoPtr->interp=interp;  /* Save just so we can delete traces at the end */
  297.     infoPtr->traceHolder = NULL;
  298.     infoPtr->depth = 0;
  299.  
  300.     Tcl_CreateCommand (interp, "tracecon", Tcl_TraceConCmd, 
  301.                        (ClientData)infoPtr, CleanUpDebug);
  302.  
  303.     Tcl_CreateCommand (interp, "traceproc", Tcl_TraceProcCmd, 
  304.                        (ClientData)infoPtr, (void (*)())NULL);
  305. }
  306.